home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tpa2_a.arc
/
COMPARE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-28
|
7KB
|
183 lines
{═════════════════════════ COMPARE.PAS ═════════════════════════}
{ Usage: Compare fname1.ext fname2.ext }
{ (Use "Options Parameters" when run from Editor) }
{═════════════════════════ COMPARE.PAS ═════════════════════════}
{- Compare two files and set errorlevel if they differ. Also }
{- display a Hex and Ascii comparison of the first 15 bytes }
{- following a miscompare. Demonstrates calling a Pascal }
{- Procedure (DumpBytes) from within Assemble. }
{══════════════════════════ HexDigits ══════════════════════════}
CONST HexDigits: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
{═══════════════════════════ HexByte ═══════════════════════════}
TYPE St2 = STRING[2];
FUNCTION HexByte(SrcB: BYTE): St2;
BEGIN
HexByte := HexDigits[SrcB Shr 4] + HexDigits[SrcB AND $F];
END; {FUNCTION HexByte}
{═══════════════════════════ HexWord ═══════════════════════════}
TYPE St4 = STRING[4];
FUNCTION HexWord(SrcW: INTEGER): St4;
BEGIN
HexWord := HexByte(Hi(SrcW)) + HexByte(Lo(SrcW));
END; {FUNCTION HexByte}
{══════════════════════════ DumpBytes ══════════════════════════}
{ Dump 16 byte comparison in Hex and Ascii }
{══════════════════════════ DumpBytes ══════════════════════════}
PROCEDURE DumpBytes(Offset: INTEGER; Var B1,B2: BYTE);
VAR n,b: BYTE;
BEGIN
WRITELN( 'First compare error at Offset: ',HexWord(Offset) );
WRITE('F1: ');
FOR n := 0 TO 15 DO WRITE(' ',HexByte(Mem[Seg(B1):Ofs(B1)+n]));
WRITE(' ');
FOR n := 0 TO 15 DO BEGIN
b := Mem[Seg(B1):Ofs(B1)+n];
IF b < 32 THEN WRITE('·') {- avoid certain unprintable characters -}
ELSE WRITE(Chr(b));
END; {FOR n := 0 TO 15 DO }
WRITELN;
WRITE('F2: ');
FOR n := 0 TO 15 DO WRITE(' ',HexByte(Mem[Seg(B2):Ofs(B2)+n]));
WRITE(' ');
FOR n := 0 TO 15 DO BEGIN
b := Mem[Seg(B2):Ofs(B2)+n];
IF b < 32 THEN WRITE('·') {- avoid certain unprintable characters -}
ELSE WRITE(Chr(b));
END; {FOR n := 0 TO 15 DO }
WRITELN;
END; {PROCEDURE DumpBytes}
{══════════════════════════ Identical ══════════════════════════}
{ Compare COUNT bytes at address V1 with bytes at address V2 }
{ Matches calling convention for Standard Procedure Move }
{ Calls Pascal Procedure DumpBytes to display differences if }
{ files are not identical. }
{══════════════════════════ Identical ══════════════════════════}
FUNCTION Identical(VAR V1,V2; Count: INTEGER): BOOLEAN;
BEGIN
ASSEMBLE
Cld
Mov Identical,TRUE
Push Ds
Mov Cx,Count
Les Di,V1
Lds Si,V2 ;GLOBAL Pascal symbols unavailable until we Pop Ds again
RepE CmpsB
Mov Dx,Ds ;Save Seg(V2) Preserves Flags
Pop Ds ;restore Turbo Ds Preserves Flags
jE Finish ; (using flags from RepE CmpsB)
Mov Identical,FALSE
Dec Di,Si ; Undo implicit 'Inc Di,Si' from last CmpsB
Mov Ax,Di ; compute offset of first miscompare
Sub Ax,W V1 ;'W V1' uses low Word of V1 (overrides Dword definition)
; Push registers you want preserved
; (Ax,Bx,Cx,Dx,Di,Si, and Es may be modified by the Pascal Proc/Function)
; Now Push Parameters for Pascal Proc call
; Multiple operands to Push, Pop, Inc, Dec
; - A86 specialty supported for compatibility
Push Ax, Es,Di, Dx,Si ; Push Offset, Ptr(Byte in File1), Ptr(Byte in File2)
Call DumpBytes ; Display byte comparison and remove parameters
; Pop registers you pushed above
Finish:
END; {Assemble}
END; {FUNCTION Identical(Var V1,V2; Count:WORD);}
{══════════════════════════ MaxAvailK ══════════════════════════}
{ Size of largest available block on heap in 1K (1024) units }
{ Corrects for differences in Version 3/Version 4 MaxAvail }
{══════════════════════════ MaxAvailK ══════════════════════════}
FUNCTION MaxAvailK: INTEGER; BEGIN
IF $FFFF > 0 THEN MaxAvailK := MaxAvail SHR 10 {- Version 4 -}
ELSE MaxAvailK := MaxAvail SHR 6; {- Version 3 -}
END; {FUNCTION MaxAvailK: INTEGER;}
TYPE
BufferType= ARRAY[1..$7FFF] OF BYTE; {- 32767 bytes -}
VAR
Buffer1,Buffer2: ^BufferType;
File1,File2: File;
Size1,Size2: INTEGER;
BEGIN {MAIN}
IF MaxAvailK < 65 THEN BEGIN
WRITELN('This Demonstration requires 64K available memory');
WRITELN('Version 4 users, try using the command line compiler as follows:');
WRITELN('A>tpam tpc compare /r"fname1.ext fname2.ext" - OR -');
WRITELN('A>tpam c compare /r"fname1.ext fname2.ext"');
Halt(3);
END; {IF MaxAvailK < 65 THEN }
IF ParamCount<>2 THEN BEGIN
WRITELN('Invalid number of parameters');
IF ParamCount=0
THEN WRITELN('(Use "Options Parameters" to run from the Editor)');
Halt(2);
END; {IF ParamCount=0 THEN }
New(Buffer1); New(Buffer2);
{$I-}
Assign(File1,ParamStr(1)); Reset(File1,1);
IF IOresult<>0 THEN BEGIN
WRITELN('File ',ParamStr(1),' not found'); Halt(2);
END; {IF IOresult<>0 THEN }
Assign(File2,ParamStr(2)); Reset(File2,1);
IF IOresult<>0 THEN BEGIN
WRITELN('File ',ParamStr(2),' not found'); Halt(2);
END; {IF IOresult<>0 THEN }
{$I+}
BlockRead(File1,Buffer1^,SizeOf(Buffer1^),Size1);
BlockRead(File2,Buffer2^,SizeOf(Buffer2^),Size2);
IF (Size1 = SizeOf(Buffer1^)) OR (Size2 = SizeOf(Buffer2^)) THEN BEGIN
IF (Size1 = SizeOf(Buffer1^)) THEN WRITE('File ',ParamStr(1))
ELSE WRITE('File ',ParamStr(2));
WRITELN(' is too large');
WRITELN('This Demonstration limited to files smaller than 32K'); Halt(2);
END; {IF (Size1 = SizeOf(Buffer1^)) OR (Size2 = SizeOf(Buffer2^)) THEN }
WRITELN(Size1,' Bytes in file F1: ',ParamStr(1));
WRITELN(Size2,' Bytes in file F2: ',ParamStr(2));
IF Size1<>Size2 THEN BEGIN
IF Size1<Size2
THEN IF Identical(Buffer1^,Buffer2^,Size1)
THEN WRITELN('Bytes left in F2')
ELSE WRITELN('Files are different')
ELSE IF Identical(Buffer1^,Buffer2^,Size2)
THEN WRITELN('Bytes left in F1')
ELSE WRITELN('Files are different');
Halt(1);
END; {IF Size1<>Size2 THEN }
IF Identical(Buffer1^,Buffer2^,Size1) THEN BEGIN
WRITELN('Files are identical'); Halt(0);
END {IF Identical(Buffer1^,Buffer2^,Size1) THEN }
ELSE BEGIN
WRITELN('Files are different'); Halt(1);
END; {ELSE }
END.